home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / dupoutf.arc / CPP1740.CLP next >
Encoding:
Text File  |  1991-12-04  |  2.7 KB  |  64 lines
  1.  CPP1740:    PGM        (&FILE &FORMAT &SIZE &MEMBERS)
  2.  
  3.              /*         Program - CPP1740 */
  4.              /*         Duplicates an output file */
  5.              /*         CPP for command DUPOUTF */
  6.  
  7.              DCL        &FILE *CHAR 20
  8.              DCL        &FORMAT  *CHAR 22
  9.              DCL        &OUTFILE *CHAR 10
  10.              DCL        &SIZE *CHAR 20
  11.              DCL        &MEMBERS *DEC 5
  12.              DCL        &MAXMBRS *CHAR 6
  13.  
  14.              DCL        &CNT    *DEC  3
  15.              DCL        &MSGID  *CHAR 7
  16.              DCL        &MSGDTA *CHAR 132
  17.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSG)
  18.  
  19.              IF         (%SST(&FORMAT 03 10) *EQ  'DSPFD') +
  20.              CHGVAR     VAR(&OUTFILE) VALUE(%SST(&FORMAT 13 10))
  21.              ELSE       +
  22.              CHGVAR     VAR(&OUTFILE) VALUE(%SST(&FORMAT 03 10))
  23.  
  24.  DUPOBJ:     CRTDUPOBJ  OBJ(&OUTFILE) FROMLIB(QSYS) OBJTYPE(*FILE) +
  25.                           TOLIB(%SST(&FILE 11 10))
  26.  RENAME:     RNMOBJ     OBJ(&OUTFILE.%SST(&FILE 11 10)) +
  27.                           OBJTYPE(*FILE) NEWOBJ(%SST(&FILE 01 10))
  28.  
  29.  CHGSIZE:    IF         (%SST(&SIZE 03 05) *EQ '*SAME') GOTO CHGMBRS
  30.              IF         (%SST(&SIZE 03 05) *EQ '*NOMAX') DO
  31.              CHGPF      FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  32.                           SIZE(*NOMAX)
  33.              ENDDO
  34.              ELSE       DO
  35.              CHGPF      FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  36.                            SIZE(%SST(&SIZE 03 08) +
  37.                           %SST(&SIZE 11 05) %SST(&SIZE 16 05))
  38.              ENDDO
  39.  
  40.  CHGMBRS:    IF         (&MEMBERS *EQ -1) GOTO ENDPGM /* *SAME */
  41.              IF         (&MEMBERS *EQ  0) DO   /* *NOMAX */
  42.                         CHGVAR VAR(&MAXMBRS) VALUE('*NOMAX')
  43.              ENDDO
  44.              ELSE       DO
  45.                         CHGVAR VAR(&MAXMBRS) VALUE(&MEMBERS)
  46.              ENDDO
  47.              CHGPF      FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  48.                          MAXMBRS(&MAXMBRS)
  49.  
  50.  RCVMSG:     /*         Receive and forward program messages. */
  51.              RCVMSG     RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
  52.              IF         (&MSGID *EQ ' ')  RETURN
  53.              IF         (%SST(&MSGID 1 2) *EQ 'CP'  +
  54.                      *OR %SST(&MSGID 1 3) *EQ 'MCH')  DO
  55.              IF         (&MSGDTA *EQ ' ') SNDPGMMSG  MSGID(&MSGID) +
  56.                           MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  57.              ELSE       SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) +
  58.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  59.              CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  60.              ENDDO
  61.              IF         (&CNT *LT 10) GOTO RCVMSG
  62.  
  63.  ENDPGM:     ENDPGM
  64.